; > fp2
 [ FP=0
COSOP STMFD SP!,{R14}
 B COS1
 ]
COS STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
COS1 CMP FACCX,#&98
 BCS FRNGQQ
 MOV R10,#0
 MOV FSIGN,#0
 FPUSH ;stack |X|
 ADR TYPE,HALFPI
 BL FADD
 BL FRANGE
 BLMI FCLR
 BL INTRND
 TST FACC,#1
 EORNE R10,R10,#&80000000
 BL IFLT
 MOV FWSIGN,#&80000000
 MOV FWACC,#&80000000
 MOV FWACCX,#&80
 BL FADDW
 B SINCOMMON
 |
 COSD FACC,FACC
 MOVS TYPE,#TFP
 LDMFD SP!,{PC}
 ]
 [ FP=0
SINOP STMFD SP!,{R14}
 B SIN1
 ]
SIN ROUT
 STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
SIN1 CMP FACCX,#&98
 BCS FRNGQQ
 MOV R10,FSIGN
 MOV FSIGN,#0
 FPUSH ;stack |X|
 BL FRANGE
 BLMI FCLR
 BL INTRND
 TST FACC,#1
 EORNE R10,R10,#&80000000
 TEQ FACC,#0
 BEQ %20
 BL IFLT
;
; STMFD SP!,{FACC,FSIGN,FACCX}
; ADR TYPE,HPIHI
; BL FMUL
; ADD TYPE,SP,#3*4+4 ;input value
; BL FADD
; FSTA TYPE
; LDMFD SP!,{FACC,FSIGN,FACCX}
; ADR TYPE,HPILO
; BL FMUL
; ADD TYPE,SP,#4 ;input value
; BL FADD
;
; Here follows DJS's disgusting code to multiply FACC by pi
;  = (2^0) + (2^-1) + (2^-4) + (2^-7) + (2^-11) - (2^-18) - (2^-20)
;    + (2^-22) + (2^-24) + (2^-26) + (2^-30) + (2^-34) + (2^-38)
;    - (2^-40) - (2^-42) + (2^-44) - (2^-49)
SINCOMMON MOV FGRD,FACC,LSR #2
 ADD FGRD,FGRD,FACC,LSR #6
 SUB FGRD,FGRD,FACC,LSR #8
 SUB FGRD,FGRD,FACC,LSR #10
 ADD FGRD,FGRD,FACC,LSR #12
 SUB FGRD,FGRD,FACC,LSR #17
 MOV FWACC,#0
 ADDS FGRD,FGRD,FACC,LSL #31
 ADC FWACC,FWACC,FACC,LSR #1
 ADDS FGRD,FGRD,FACC,LSL #28
 ADC FWACC,FWACC,FACC,LSR #4
 ADDS FGRD,FGRD,FACC,LSL #25
 ADC FWACC,FWACC,FACC,LSR #7
 ADDS FGRD,FGRD,FACC,LSL #21
 ADC FWACC,FWACC,FACC,LSR #11
 SUBS FGRD,FGRD,FACC,LSL #14
 SBC FWACC,FWACC,FACC,LSR #18
 SUBS FGRD,FGRD,FACC,LSL #12
 SBC FWACC,FWACC,FACC,LSR #20
 ADDS FGRD,FGRD,FACC,LSL #10
 ADC FWACC,FWACC,FACC,LSR #22
 ADDS FGRD,FGRD,FACC,LSL #8
 ADC FWACC,FWACC,FACC,LSR #24
 ADDS FGRD,FGRD,FACC,LSL #6
 ADC FWACC,FWACC,FACC,LSR #26
 ADDS FGRD,FGRD,FACC,LSL #2
 ADC FWACC,FWACC,FACC,LSR #30
 ADDS FACC,FACC,FWACC
 ADDCS FACCX,FACCX,#1 ;Re-normalise
 MOVCS FGRD,FGRD,LSR #1
 ORRCS FGRD,FGRD,FACC,LSL #31
 MOVCS FACC,FACC,RRX
 ADD FACCX,FACCX,#1
;
; No overflow/underflow possible. Rounding not wanted because both
; parts of result are going to be subtracted from value on stack
;
 EOR FSIGN,FSIGN,#&80000000 ;Negate to do subtraction (not 0-0 situation)
 MOV TYPE,SP ;input value
 STMFD SP!,{FGRD,FSIGN,FACCX}
 BL FADD
 FSTA TYPE
 LDMFD SP!,{FGRD,FSIGN,FACCX} ;Recover guard word
 SUB FACCX,FACCX,#32
 MOVS FACC,FGRD
 BEQ %20
10 SUBPL FACCX,FACCX,#1 ;Re-normalise - NB expected to be faster than
 MOVPLS FACC,FACC,LSL #1 ;binary chop method in this environment
 BPL %10
 TEQ FACCX,#0
 BMI %20
 MOV TYPE,SP
 BL FADD ;result of first addition
 FSTA TYPE
 B %30
20
 FLDA SP ;input value
30 CMP FACCX,#&71
 BCC ENDSIN
 BL FSQR
 FPUSH ;stack g, f
 ADR TYPE,SINR5
 BL FMUL
 ADR TYPE,SINR4
 BL FADD
 MOV TYPE,SP
 BL FMUL
 ADR TYPE,SINR3
 BL FADD
 MOV TYPE,SP
 BL FMUL
 ADR TYPE,SINR2
 BL FADD
 MOV TYPE,SP
 BL FMUL
 ADR TYPE,SINR1
 BL FADD
 MOV TYPE,SP
 BL FMUL
 ADD SP,SP,#8
 MOV TYPE,SP
 BL FMUL
 BL FADD
ENDSIN ADD SP,SP,#8
 EOR FSIGN,FSIGN,R10
 |
 SIND FACC,FACC
 ]
 MOVS TYPE,#TFP
 LDMFD SP!,{PC}
 [ FP=0
SINR5 DCD &CD070C7F
 = &67,0,0,&80 ;-.2386834640601E-7
SINR4 DCD &B8B5D27E
 = &6E,0,0,0 ;.2752397106775E-5
SINR3 DCD &D00BD47F
 = &74,0,0,&80 ;-.1984083282313E-3
SINR2 DCD &888885BA
 = &7A,0,0,0 ;.8333330720556E-2
SINR1 DCD &AAAAAAA1
 = &7E,0,0,&80 ;-.16666666608836
 ]
ATN STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
 STMFD SP!,{FSIGN} ;stack sign
 MOV FSIGN,#0 ;force +ve
 MOV R10,#0
 CMP FACCX,#&81
 CMPEQ FACC,#&80000001
 BCC FATNA
 BL FRECIP
 MOV R10,#2
FATNA CMP FACCX,#&7F ;test if greater than .2679491924
 CMPEQ FACC,#&89000000
 CMPEQ FACC,#&00300000
 CMPEQ FACC,#&0000A200
 CMPEQ FACC,#&000000F5
 BCC FATNB
 FPUSH ;stack f
 ADR TYPE,ATNCONST1
 BL FMUL
 MOV FWACC,#&80000000
 MOV FWACCX,#&81
 MOV FWSIGN,#&80000000
 BL FADDW
 FPUSH ;stack top, f
 ADD TYPE,SP,#8
 FLDA TYPE
 ADR TYPE,ATNCONST1
 BL FADD
 MOV TYPE,SP
 BL FXDIV
 ADD SP,SP,#16
 ADD R10,R10,#1
FATNB CMP FACCX,#&71
 BCC FATNC ;very small number
 FPUSH ;stack f, sign, link
 BL FSQR
 FPUSH ;stack g, f etc.
 ADR TYPE,ATNP1
 BL FMUL
 ADR TYPE,ATNP0
 BL FADD
 MOV TYPE,SP
 BL FMUL
 FPUSH ;stack q*P(q), g, f etc.
 ADD TYPE,SP,#8
 FLDA TYPE
 ADR TYPE,ATNQ1
 BL FADD
 ADD TYPE,SP,#8
 BL FMUL
 ADR TYPE,ATNQ0
 BL FADD
 MOV TYPE,SP
 BL FXDIV
 ADD TYPE,SP,#16
 BL FMUL
 BL FADD
 ADD SP,SP,#24
FATNC CMP R10,#1
 EORHI FSIGN,FSIGN,#&80000000
 BCC FATND
 CMP R10,#2
 ADRLT TYPE,SIXTHPI
 ADREQ TYPE,HALFPI
 ADRHI TYPE,THIRDPI
 BL FADD
FATND LDMFD SP!,{R4,R14}
 CMP R4,#0
 EORNE FSIGN,FSIGN,#&80000000
 TEQ FACC,#0
 MOVEQ FSIGN,#0
 MOVS TYPE,#TFP
 MOV PC,R14
 |
 ATND FACC,FACC
 B FSINSTK
 ]
 [ FP=0
ATNCONST1 DCD &DDB3D743
 = &81,0,0,0 ;SQR3=1.732050807568877
ATNP1 DCD &B853ADF8
 = &80,0,0,&80 ;-.720026848898
ATNP0 DCD &B854A78A
 = &81,0,0,&80 ;-1.44008344874
ATNQ1 DCD &98123BF0
 = &83,0,0,0 ;4.75222584599
ATNQ0 DCD &8A3F7DBF
 = &83,0,0,0 ;4.32025038919
; Here follows DJS's disgusting code to multiply FACC by 1/pi
;  = A2F9836E hex      (exponent 7F)
;  = (2^-1) + (2^-3) + (2^-6) - (2^-8) - (2^-13) + (2^-15) - (2^-17)
;    + (2^-22) - (2^-25) - (2^-28) - (2^-31)
FRANGE MOV FWGRD,FACC,LSL #30
 MOV FWACC,FACC,LSR #2
 ADDS FWGRD,FWGRD,FACC,LSL #27
 ADC FWACC,FWACC,FACC,LSR #5
 SUBS FWGRD,FWGRD,FACC,LSL #25
 SBC FWACC,FWACC,FACC,LSR #7
 SUBS FWGRD,FWGRD,FACC,LSL #20
 SBC FWACC,FWACC,FACC,LSR #12
 ADDS FWGRD,FWGRD,FACC,LSL #18
 ADC FWACC,FWACC,FACC,LSR #14
 SUBS FWGRD,FWGRD,FACC,LSL #16
 SBC FWACC,FWACC,FACC,LSR #16
 ADDS FWGRD,FWGRD,FACC,LSL #11
 ADC FWACC,FWACC,FACC,LSR #21
 SUBS FWGRD,FWGRD,FACC,LSL #8
 SBC FWACC,FWACC,FACC,LSR #24
 SUBS FWGRD,FWGRD,FACC,LSL #5
 SBC FWACC,FWACC,FACC,LSR #27
 SUBS FWGRD,FWGRD,FACC,LSL #2
 SBC FWACC,FWACC,FACC,LSR #30
 ADDS FACC,FACC,FWACC
 SUBCC FACCX,FACCX,#1 ;Adjust exponent or re-normalise
 MOVCS FWGRD,FWGRD,LSR #1
 ORRCS FWGRD,FWGRD,FACC,LSL #31
 MOVCS FACC,FACC,RRX
 CMP FWGRD,#&80000000 ;Round correctly
 BICEQ FACC,FACC,#1
 ADDCSS FACC,FACC,#1
 MOVCS FACC,FACC,RRX
 ADDCS FACCX,FACCX,#1
 SUB FACCX,FACCX,#1
 TEQ FACCX,#0 ;Handle underflow (overflow is impossible)
 MOV PC,R14
 ]
;convert fp acc to a string in stracc
;using format given by word in R4, returns with TYPE 1 after last char
 [ FP=0
MAXDIGS * 10
 |
MAXDIGS * 18
 ]
;format 0: General format nnnn.nnn fixes maximum number of digits [or use 1]
;format 1: Exponent format n.nnEnn fixes number of digits
;format 2: Fixed format nnnnnn.nnn fixes number of digits after . [or use 1]
FMAT RN R5
FDIGS RN R4 ;(no harm the way currently written)
FPRTDX RN R7
FPRTWN RN R6
FCONFP TEQ R5,#0
 BNE FCONHX
 MOV FMAT,R4,LSR #16
 AND FMAT,FMAT,#&7F
 TST R4,#&800000
 MOV FDIGS,R4,LSR #8
 AND FDIGS,FDIGS,#255
 ORREQ FDIGS,FDIGS,#&2e000000
 ORRNE FDIGS,FDIGS,#&2c000000 ;put in . or ,
 CMP FMAT,#3
 MOVCS FMAT,#0 ;if unknown format use 0
 AND R7,FDIGS,#255
 CMP R7,#MAXDIGS+1
 BICCS FDIGS,FDIGS,#255
 ORRCS FDIGS,FDIGS,#MAXDIGS ;if too high number of digs use 10/18
 TST FDIGS,#255
 BNE FCONA
 TEQ FMAT,#2
 ORRNE FDIGS,FDIGS,#MAXDIGS ;if not in format 2 use maximum digits instead of 0
FCONA MOV FPRTDX,#0
 STMFD SP!,{FDIGS,R14} ;May need fdigs again
 BL FLOATY
 ADD TYPE,ARGP,#STRACC
 [ FP=0
 CMP FACC,#0
 BNE FPRTA
 TEQ FMAT,#0
 MOVEQ R6,#"0"
 STREQB R6,[TYPE],#1
 LDMEQFD SP!,{R6,PC} ;discard fdigs and return for 0 in E format
 TEQ FMAT,#1
 BEQ FPRTH
 B FPRTZR
FPRTA MOV FGRD,#0
 TEQ FSIGN,#0
 MOVMI FSIGN,#"-"
 STRMIB FSIGN,[TYPE],#1
 MOVMI FSIGN,#0
FPRTC CMP FACCX,#&81
 BCS FPRTD
 BL FTENFX
 SUB FPRTDX,FPRTDX,#1
 B FPRTC
FPRTD CMP FACCX,#&84
 BCC FPRTF
 BNE FPRTE
 CMP FACC,#&A0000000
 BCC FPRTF
FPRTE BL FTENFQ
 ADD FPRTDX,FPRTDX,#1
 B FPRTC
FPRTEE BL FONE
 ADD FPRTDX,FPRTDX,#1
 B FPRTC
;table of round up constant values
FPRTROUNDTAB & &A0000000
 & &00000083
 & &00000000
 & &00000000
 & &80000000
 & &00000080
 & &00000000
 & &00000000
 & &CCCCCCCC
 & &0000007C
 & &CCCCCCCD
 & &00000000
 & &A3D70A3D
 & &00000079
 & &70A3D707
 & &00000000
 & &83126E97
 & &00000076
 & &8D4FDF38
 & &00000000
 & &D1B71758
 & &00000072
 & &E2196525
 & &00000000
 & &A7C5AC47
 & &0000006F
 & &1B47841B
 & &00000000
 & &8637BD05
 & &0000006C
 & &AF6C69AE
 & &00000000
 & &D6BF94D5
 & &00000068
 & &E57A42AE
 & &00000000
 & &ABCC7711
 & &00000065
 & &8461CEEF
 & &00000000
 & &89705F41
 & &00000062
 & &36B4A589
 & &00000000
FPRTF LDR FDIGS,[SP] ;stacked fdigs
 CMP FMAT,#2
 BNE FPRTFH
 AND R6,FDIGS,#255
 ADCS R6,R6,FPRTDX ;fix up precision by adding exponent digit count
 BMI FPRTZR
 CMP R6,#MAXDIGS+1 ;how many digits?
 MOVCS R6,#MAXDIGS
 MOVCS FMAT,#0 ;treat as G10 format if unreasonable
 BIC FDIGS,FDIGS,#255
 ORR FDIGS,FDIGS,R6
FPRTFH STMFD SP!,{FMAT,FPRTDX,FDIGS,FACC,FGRD,FSIGN,FACCX} ;facc stuff closest
 [ 1=0
;code to compute round up constants if FTENFQ precision changes
 MOV FACC,#&A0000000
 MOV FACCX,#&83
 MOV FGRD,#0
 MOV FSIGN,#0 ;5 to acc
 BL FSHOW
 ANDS FWACCX,FDIGS,#255
 BEQ FPRTGJ
FPRTGG BL FTENFQ
 BL FSHOW
 SUBS FWACCX,FWACCX,#1
 BNE FPRTGG
 |
 ADR FACC,FPRTROUNDTAB
 AND R7,FDIGS,#255
 ADD FACC,FACC,R7,LSL #4
 LDMIA FACC,{FACC,FACCX,FGRD,FSIGN}
 ]
FPRTGJ LDMFD SP!,{FWACCX,FWSIGN,FWGRD,FWACC} ;since facc stuff was closest
 BL FADDW1
FPRTFF CMP FACCX,#&84
 BLCC FTENFA
 BCC FPRTFF ;note that this relies on ftenfa preserving C on exit
 LDMFD SP!,{FDIGS,FPRTDX,FMAT}
 CMP FACC,#&A0000000
 BCS FPRTEE ;see if unnormalised: fix up if so
 TST FDIGS,#255
 BNE FPRTH
FPRTZR LDR FDIGS,[SP]
 ADD FDIGS,FDIGS,#1
 BL FCLR
 MOV FPRTDX,#0
FPRTH MOV FPRTWN,#1
 TEQ FMAT,#1
 BEQ FPRTK
 TEQ FPRTDX,#0
 BMI FPRTKK
 AND FSIGN,FDIGS,#255
 CMP FPRTDX,FSIGN
 BCS FPRTK
 ADD FPRTWN,FPRTDX,#1
 MOV FPRTDX,#0
 B FPRTK
FPRTKK TEQ FMAT,#2
 BEQ FPRTKL
 CMN FPRTDX,#1
 CMNNE FPRTDX,#2
 BNE FPRTK
FPRTKL MOV FPRTWN,FDIGS,LSR #24 ;get . or ,
 STRB FPRTWN,[TYPE,#1] ;store "0." in string (interestingly!)
 MOV FPRTWN,#"0"
 STRB FPRTWN,[TYPE],#2 ;put the zero at the beginning and then skip the .
FPRTKM ADDS FPRTDX,FPRTDX,#1
 STRNEB FPRTWN,[TYPE],#1 ;put in 0 if ne 0
 BNE FPRTKM ;round again
 MOV FPRTWN,#&80
FPRTK MOV FSIGN,FACC,LSR #32-4
 ORR FSIGN,FSIGN,#"0"
 STRB FSIGN,[TYPE],#1
 BIC FACC,FACC,#&F0000000
 ADDS FGRD,FGRD,FGRD ;40 bit mantissa * 10.0
 ADC FACC,FACC,FACC
 MOV FSIGN,FGRD,LSR #32-2
 ORR FSIGN,FSIGN,FACC,LSL #2
 ADDS FGRD,FGRD,FGRD,LSL #2
 ADCS FACC,FACC,FSIGN
 SUBS FPRTWN,FPRTWN,#1
 MOVEQ FSIGN,FDIGS,LSR #24
 STREQB FSIGN,[TYPE],#1
 SUB FDIGS,FDIGS,#1
 TST FDIGS,#255
 BNE FPRTK
 TEQ FMAT,#1
 BEQ FPRTTX
 TEQ FMAT,#2
 BEQ FPRTTY
FPRTTZ LDRB FSIGN,[TYPE,#-1]!
 CMP FSIGN,#"0"
 BEQ FPRTTZ
 CMP FSIGN,FDIGS,LSR #24
 ADDNE TYPE,TYPE,#1
FPRTTY TEQ FPRTDX,#0
 BEQ FPRTX
FPRTTX MOV FSIGN,#"E"
 STRB FSIGN,[TYPE],#1
 ADDS FPRTWN,FPRTDX,#0
 MOVMI FSIGN,#"-"
 STRMIB FSIGN,[TYPE],#1
 RSBMI FPRTWN,FPRTWN,#0
 MOV FSIGN,#"0"
IPRTA SUBS FPRTWN,FPRTWN,#10
 ADDCS FSIGN,FSIGN,#1
 BCS IPRTA
 TEQ FSIGN,#"0"
 STRNEB FSIGN,[TYPE],#1
 ADD FPRTWN,FPRTWN,#"0"+10
 STRB FPRTWN,[TYPE],#1
 TEQ FMAT,#0
 BEQ FPRTX
 MOV FGRD,#" "
 TEQ FPRTDX,#0
 STRPLB FGRD,[TYPE],#1
 TEQ FSIGN,#"0"
 STREQB FGRD,[TYPE],#1
FPRTX LDMFD SP!,{FDIGS,PC}
 |
;format 0: General format nnnn.nnn fixes maximum number of digits [or use 1]
;format 1: Exponent format n.nnEnn fixes number of digits
;format 2: Fixed format nnnnnn.nnn fixes number of digits after . [or use 1]
;FDIGS=R4, FMAT=R5
 STFP FACC,[SP,#-12]!
 LDMFD SP,{R0,R1,R2}
 TEQ R0,#0
 MOVMI R6,#"-"
 STRMIB R6,[TYPE],#1
 STMFD SP!,{TYPE}
 MOV R3,R0,LSR #12
 AND R6,R3,#&FF0
 AND R3,R3,#15
 CMP R6,#&10
 ADDEQ R3,R3,#10
 MOVHI R3,#0
 AND R7,FDIGS,#255
 CMP R3,R7 ;maximum number of digits!
 MOVCS R3,#0
 CMP FMAT,#0
 BNE FPRTFA
 CMP R3,#3
 BCS FPRTFA
 CMP R3,#0
 TSTNE R0,#TINTEGER
 BEQ FPRTFA
 MOV R7,R3
 MOV R6,#0
 MOV R3,#1
 BL FPRTNIBBLEDOT ;0.
 CMP R7,#2
 MOV R6,#0
 BLEQ FPRTNIBBLE
 BIC R0,R0,#&F000 ;remove 1 or 2
 B FPRTFGO
FPRTFA TST R0,#TINTEGER
 MOVNE R3,#0
 CMP FMAT,#1
 MOVEQ R3,#0
 CMP FMAT,#2
 BNE FPRTFH
 ADC FDIGS,FDIGS,R3 ;fix up precision
 AND R7,FDIGS,#255
 CMP R7,#MAXDIGS+1 ;how many digits?
 BICCS FDIGS,FDIGS,#255
 ORRCS FDIGS,FDIGS,#MAXDIGS
 MOVCS FMAT,#0 ;treat as G18 format if unreasonable
FPRTFH
;subtract from exponent
 MOV R7,R3
 CMP R3,#10
 SUBCS R0,R0,#1 :SHL: 16
 SUBCS R7,R7,#10
 SUB R0,R0,R7,LSL #12
 ADD R3,R3,#1
FPRTFGO MOV R6,R0,LSR #8
 BL FPRTNIBBLEDOT
 MOV R7,R0
 BL FPRTBYTE
 MOV R7,R1,LSR #24
 BL FPRTBYTE
 MOV R7,R1,LSR #16
 BL FPRTBYTE
 MOV R7,R1,LSR #8
 BL FPRTBYTE
 MOV R7,R1
 BL FPRTBYTE
 MOV R7,R2,LSR #24
 BL FPRTBYTE
 MOV R7,R2,LSR #16
 BL FPRTBYTE
 MOV R7,R2,LSR #8
 BL FPRTBYTE
 MOV R7,R2
 BL FPRTBYTE
 LDMFD SP!,{R2}
 AND R7,FDIGS,#255
 ADD TYPE,R2,R7
 ADD TYPE,TYPE,#1 ;. must be somewhere
 ADD R6,TYPE,#1 ;round position
 MOV R3,#5
FPRTRND CMP R2,R6 ;reached the first digit?
 BLEQ FPRTRNDPANIC ;yes: number has another digit!
 LDRB R7,[R6,#-1]!
 CMP R7,FDIGS,LSR #24 ;check for ./,
 BEQ FPRTRND ;don't round the ./, (!)
 ADD R7,R7,R3 ;add the round value
 CMP R7,#"9"+1 ;is there a carry?
 MOVCS R3,#1 ;yes: propogate up
 SUBCS R7,R7,#10 ;yes: and reduce back to digit
 STRB R7,[R6] ;put rounded number back
 BCS FPRTRND ;go round again if carry
 TEQ FMAT,#1
 BEQ FPRTTX
 TEQ FMAT,#2
 BEQ FPRTTY
FPRTTZ LDRB R6,[TYPE,#-1]! ;remove trailing 0s
 CMP R6,#"0"
 BEQ FPRTTZ
 CMP R6,FDIGS,LSR #24 ;stopped at ./,?
 ADDNE TYPE,TYPE,#1 ;if didn't put back the character (else remove ./,)
FPRTTY MOV R7,R0,LSR #12
 ORR R6,R7,R7,LSR #4
 ANDS R6,R6,#255
 BEQ FPRTNOEXPNT
FPRTTX MOV R6,#"E"
 STRB R6,[TYPE],#1
 TST R0,#TINTEGER
 MOVNE R6,#"-"
 STRNEB R6,[TYPE],#1
 MOV R6,R0,LSR #20
 ANDS R6,R6,#15
 BLNE FPRTNIBBLE
 MOV R6,R0,LSR #16
 ANDEQS R6,R6,#15
 BLNE FPRTNIBBLE
 MOV R6,R0,LSR #12
 BL FPRTNIBBLE
 TEQ FMAT,#0
 BEQ FPRTNOEXPNT
 MOV R6,#" "
 TST R0,#TINTEGER
 STREQB R6,[TYPE],#1
 TST R0,#&F00000
 STREQB R6,[TYPE],#1
 TSTEQ R0,#&F0000
 STREQB R6,[TYPE],#1
FPRTNOEXPNT ADD SP,SP,#12
 LDMFD SP!,{FDIGS,PC}
FPRTRNDPANIC MOV R6,TYPE
FPRTRNDPANICCOPY LDRB R7,[R6,#-1]
 STRB R7,[R6],#-1
 CMP R6,R2
 BNE FPRTRNDPANICCOPY
 MOV R7,#"0"
 STRB R7,[R6]
 ADD R6,R2,#1
 ADD TYPE,TYPE,#1
 MOV PC,R14
FPRTBYTE MOV R6,R7,LSR #4
 AND R6,R6,#15
 ADD R6,R6,#&30
 STRB R6,[TYPE],#1
 SUBS R3,R3,#1
 MOVEQ R6,FDIGS,LSR #24
 STREQB R6,[TYPE],#1
 MOV R6,R7
FPRTNIBBLEDOT AND R6,R6,#15
 ADD R6,R6,#&30
 STRB R6,[TYPE],#1
 SUBS R3,R3,#1
 MOVEQ R6,FDIGS,LSR #24
 STREQB R6,[TYPE],#1
 MOV PC,R14
FPRTNIBBLE AND R6,R6,#15
 ADD R6,R6,#&30
 STRB R6,[TYPE],#1
 MOV PC,R14
 ]
 [ FP=0
;40 bit FACC:=FACC*10
;uses only FWGRD
FTENFX MOV FWGRD,FACC,ASL #30
 ORR FWGRD,FWGRD,FGRD,LSR #2 ;concoct new guard
 ADDS FGRD,FGRD,FWGRD ;add facc,fgrd>>2 to facc,fgrd
 ADCS FACC,FACC,FACC,LSR #2 ;carry in from previous ADD, out from this ADC
 ADD FACCX,FACCX,#3 ;increase faccx by 3
 MOVCC PC,R14 ;exit if no renorm
FTENFA ADD FACCX,FACCX,#1 ;renormalise if required
 MOVS FACC,FACC,RRX
 MOV FGRD,FGRD,RRX
 MOVS PC,R14 ;restore callers state
;40 bit FACC:=FACC/10
;uses only FWGRD
FTENFQ STMFD SP!,{R14}
 TSTS FACC,FACC,LSR #1 ;set carry out from facc
 ADDS FGRD,FGRD,FGRD,RRX ;add facc,fgrd>>1 to facc,fgrd
 ADCS FACC,FACC,FACC,LSR #1
 SUB FACCX,FACCX,#4 ;decrease faccx by 4
 BLCS FTENFA
 MOV FWGRD,FACC,ASL #28
 ORR FWGRD,FWGRD,FGRD,LSR #4 ;concoct new guard
 ADDS FGRD,FGRD,FWGRD ;add facc,fgrd>>4 to facc,fgrd
 ADCS FACC,FACC,FACC,LSR #4 ;carry in from previous ADD, out from this ADC
 BLCS FTENFA
 MOV FWGRD,FACC,ASL #24
 ORR FWGRD,FWGRD,FGRD,LSR #8
 ADDS FGRD,FGRD,FWGRD ;add facc,fgrd>>8 to facc,fgrd
 ADCS FACC,FACC,FACC,LSR #8
 BLCS FTENFA
 MOV FWGRD,FACC,ASL #16
 ORR FWGRD,FWGRD,FGRD,LSR #16
 ADDS FGRD,FGRD,FWGRD ;add facc,fgrd>>16 to facc,fgrd
 ADCS FACC,FACC,FACC,LSR #16
 BLCS FTENFA
 ORR FGRD,FGRD,#1 ;perturb system slightly!
 ADDS FGRD,FGRD,FACC ;add facc,fgrd>>32 to facc,fgrd
 ADCS FACC,FACC,#0
 BLCS FTENFA
 LDMFD SP!,{PC}
 ]
;convert to hex string
FCONHX STMFD SP!,{R14}
 BL INTEGY
 ADD TYPE,ARGP,#STRACC
 MOV R2,#32-4
 MOV R3,#0 ;lzb
FCONH1 MOV R1,IACC,LSR R2
 AND R1,R1,#15
 CMP R1,#9
 ORRLS R1,R1,#"0"
 ADDHI R1,R1,#"A"-10
 TEQ R2,#0 ;last time?
 MOVEQ R3,#1
 TEQ R3,#0
 CMPEQ R1,#"0"
 MOVNE R3,#1
 STRNEB R1,[TYPE],#1
 SUBS R2,R2,#4
 BPL FCONH1
 LDMFD SP!,{PC}
FRDDXX MOVS TYPE,#TINTEGER ;clear carry: nothing read
 MOV PC,R14
;read constant from aeline: exit with aeline ready for next load of character
FREAD CMP R10,#"."
 [ FP=0
 MOV FACC,#0
 MOV FGRD,#0
 MOV FSIGN,#0 ;convenient flag for decimal pt
 MOV FWACCX,#0 ;decimal exponent
 BEQ FRDDDD
 SUB R10,R10,#"0"
 CMP R10,#9
 BHI FRDDXX ;if <0 or >9
 MOV FGRD,R10,LSL #24
 LDRB R10,[AELINE],#1
 SUBS FACCX,R10,#"0"
 BCC FRDDDP
 CMP FACCX,#9
 BHI FRDDD
 MOV FACCX,FACCX,LSL #24
 ADD FGRD,FGRD,FGRD,LSL #2
 ADD FGRD,FACCX,FGRD,LSL #1
FRDDC LDRB R10,[AELINE],#1
FRDDDP CMP R10,#"."
 BEQ FRDDDD
FRDDD CMP R10,#"E"
 BEQ FRDDEX ;start of exponent
 SUB R10,R10,#"0"
 CMP R10,#9
 BHI FRDDQ ;end of number
 CMP FACC,#&18000000 ;see how large it is
 TEQ FSIGN,#0 ;both branches need "If after ."
 BCS FRDDE
 SUBNE FWACCX,FWACCX,#1 ;if after "." dec exp
 ADDS FGRD,FGRD,FGRD
 ADC FACC,FACC,FACC
 MOV FACCX,FGRD,LSR #30
 ORR FACCX,FACCX,FACC,LSL #2
 ADDS FGRD,FGRD,FGRD,LSL #2
 ADC FACC,FACC,FACCX
 ADDS FGRD,FGRD,R10,LSL #24
 ADC FACC,FACC,#0
 B FRDDC
FRDDE ADDEQ FWACCX,FWACCX,#1 ;ignore if after "." else increase exponent
 B FRDDC
FRDDDD EORS FSIGN,FSIGN,#1 ;seen "." before ?/set seen now
 BNE FRDDC ;more chars
 EOR FSIGN,FSIGN,#1 ;reset seen
 B FRDDQ ;second one is end of number
FRDDEX MOV FWSIGN,R14
 BL FRDEXP
 MOV R14,FWSIGN
 ADD FWACCX,FWACCX,FWGRD
FRDDQ SUB AELINE,AELINE,#1
 ORRS FACCX,FWACCX,FSIGN
 BEQ FRINT ;no exponent, no decimal so possible integer
FRFP MOV FWSIGN,R14
 ORRS FACCX,FGRD,FACC
 BEQ FRDDZZ
 MOV FACCX,#&A8
 TEQ FACC,#0
 BLPL FNRMA
 TEQ FWACCX,#0
 BEQ FRDDZ
 BMI FRDDM
FRDDP BL FTENFX
 SUBS FWACCX,FWACCX,#1
 BNE FRDDP
 B FRDDZ
FRDDM BL FTENFQ
 ADDS FWACCX,FWACCX,#1
 BNE FRDDM
FRDDZ BL FTIDY
FRDDZZ MOV TYPE,#TFP
 MOV FSIGN,#0
 SUBS TYPE,TYPE,#0 ;set carry and status flags
 MOV PC,FWSIGN ;return
FRINT CMP FACC,#&800000
 BCS FRFP ;too large to represent as integer
 MOV FACC,FACC,LSL #8
 ORR FACC,FACC,FGRD,LSR #32-8
 MOV TYPE,#TINTEGER
 SUBS TYPE,TYPE,#0 ;set carry and status flags
 MOV PC,R14
FRDEXP LDRB R10,[AELINE],#1
 CMP R10,#"-"
 BEQ FRDEXM
 CMP R10,#"+"
 BNE FRDEXA
FRDEXB LDRB R10,[AELINE],#1
FRDEXA CMP R10,#"9"
 BHI FRDEXQ
 SUBS R10,R10,#"0"
 BCC FRDEXQ
 MOV FWGRD,R10
 LDRB R10,[AELINE],#1
 CMP R10,#"9"
 BHI FRDEXX
 SUBS R10,R10,#"0"
 ADDCS AELINE,AELINE,#1
 ADDCS FWGRD,FWGRD,FWGRD,LSL #2
 ADDCS FWGRD,R10,FWGRD,LSL #1
FRDEXX MOV PC,R14
FRDEXQ MOV FWGRD,#0
 MOV PC,R14
FRDEXM STMFD SP!,{R14}
 BL FRDEXB
 RSB FWGRD,FWGRD,#0
 LDMFD SP!,{PC}
 |
 MOV IACC,#0 ;32 bit mantissa low
 MOV R3,#0 ;dot not seen
 MOV R5,#0 ;decimal exponent
 BEQ FRDDOT ;starts with a .
 SUB R10,R10,#"0"
 CMP R10,#9
 BHI FRDDXX ;if <0 or >9
 MOV IACC,R10 ;first character
 LDRB R10,[AELINE],#1
 SUBS R1,R10,#"0"
 BCC FRDDDP ;could be .
 CMP R1,#9
 BHI FRDDD
 ADD IACC,IACC,IACC,LSL #2
 ADD IACC,R1,IACC,LSL #1 ;mult by 10 and add next char
FRDDC LDRB R10,[AELINE],#1
FRDDDP CMP R10,#"."
 BEQ FRDDOT
FRDDD CMP R10,#"E"
 BEQ FRDINTEX ;start of exponent
 SUB R10,R10,#"0"
 CMP R10,#9
 BHI FRDINTQ ;end of number
 ADD IACC,IACC,IACC,LSL #2
 ADD IACC,R10,IACC,LSL #1 ;mult by 10 and add next char
 CMP IACC,#&0CC00000 ;see how large it is
 BCC FRDDC
 B FRDRANGE
FRDINTQ SUB AELINE,AELINE,#1
 MOV TYPE,#TINTEGER
 SUBS TYPE,TYPE,#0 ;set carry and status flags
 MOV PC,R14
FRDDOT MOV R3,#1 ;seen dot
FRDRANGE FLTE FACC,IACC ;mantissa now floated
 MOV R7,R14
FRDFP LDRB R10,[AELINE],#1
 CMP R10,#"."
 BEQ FRDFPDOT
 CMP R10,#"E"
 BEQ FRDFPEX ;start of exponent
 SUB R10,R10,#"0"
 CMP R10,#9
 BHI FRDFPDQ ;end of number
 MUFE FACC,FACC,#10
 TEQ R3,#0 ;test to see if seen .
 FLTE F1,R10
 SUBNE R5,R5,#1 ;if after "." dec exp
 ADFE FACC,FACC,F1 ;mult by 10 and add next char
 B FRDFP
FRDFPDOT EORS R3,R3,#1 ;test to see if dot seen/set it
 BNE FRDFP
 B FRDFPDQ ;second . is end of number (already FP)
FRDINTEX FLTE FACC,IACC
 MOV R7,R14
FRDFPEX BL FRDEXP
 ADD R5,R5,R6 ;add read exponent to decimal place one
FRDFPDQ SUB AELINE,AELINE,#1
 TEQ R5,#0
 BEQ FRDDZ
 BMI FRDDM
FRDDP MUFE FACC,FACC,#10
 SUBS R5,R5,#1
 BNE FRDDP
 B FRDDZ
FRDDM DVFE FACC,FACC,#10
 ADDS R5,R5,#1
 BNE FRDDM
FRDDZ MVFD FACC,FACC
 MOV TYPE,#TFP
 SUBS TYPE,TYPE,#0 ;set carry and status flags
 MOV PC,R7 ;return
FRDEXP LDRB R10,[AELINE],#1
 CMP R10,#"-"
 BEQ FRDEXM
 CMP R10,#"+"
 BNE FRDEXA
FRDEXB LDRB R10,[AELINE],#1
FRDEXA CMP R10,#"9"
 BHI FRDEXQ
 SUBS R10,R10,#"0"
 BCC FRDEXQ
 MOV R6,R10
 LDRB R10,[AELINE],#1
 CMP R10,#"9"
 BHI FRDEXX
 SUBS R10,R10,#"0"
 BCC FRDEXX
 ADD R6,R6,R6,LSL #2
 ADD R6,R10,R6,LSL #1
 LDRB R10,[AELINE],#1
 CMP R10,#"9"
 BHI FRDEXX
 SUBS R10,R10,#"0"
 ADDCS AELINE,AELINE,#1
 ADDCS R6,R6,R6,LSL #2
 ADDCS R6,R10,R6,LSL #1
FRDEXX MOV PC,R14
FRDEXQ MOV R6,#0
 MOV PC,R14
FRDEXM STMFD SP!,{R14}
 BL FRDEXB
 RSB R6,R6,#0
 LDMFD SP!,{PC}
 ]
 LNK Expr
